% extra definitions for standard anotations
/min { 2 copy gt { exch } if pop } bind def
/BLACK { 0 0 0 } def
/RED   { 1 0 0 } def
/GREEN { 0 1 0 } def
/BLUE  { 0 0 1 } def
/WHITE { 1 1 1 } def
/LabelFont { % font size LabelFont
  exch findfont exch fsize mul scalefont setfont
} bind def
/Label { % i dx dy (text) Label
  % write text at base i plus offset dx, dy
  4 3 roll 1 sub coor exch get aload pop moveto
  3 1 roll fsize mul exch fsize mul exch rmoveto
  show
} bind def
/cmark { % i cmark   draw circle around base i
  newpath 1 sub coor exch get aload pop
  fsize 2 div 0 360 arc stroke
} bind def
/gmark { % i j c gmark
  % draw basepair i,j with c counter examples in gray
  gsave
  3 min [0 0.33 0.66 0.9] exch get setgray
  1 sub dup coor exch get aload pop moveto
  sequence exch 1 getinterval cshow
  1 sub dup coor exch get aload pop moveto
  sequence exch 1 getinterval cshow
  grestore
} bind def
/segmark { % f i j lw r g b segmark
  % mark segment [i,j] with outline width lw and color rgb
  % use omark and Fomark instead
  gsave
  setrgbcolor setlinewidth
  newpath
  1 sub exch 1 sub dup
  coor exch get aload pop moveto
  currentdict (cpr) known
  {
    3 -1 roll dup 4 1 roll dup
    {
      3 1 roll dup 3 -1 roll dup
      4 1 roll exch 5 2 roll exch
    }
    {
      3 1 roll exch
    } ifelse
    1 exch { coor exch get aload pop lineto } for
    {
      dup 3 1 roll 1 add exch 1 add arccoords pop pop
      4 2 roll 5 -1 roll coor exch get aload pop curveto
    } if
  }
  {
    exch 1 exch {
      coor exch get aload pop lineto
    } for
  } ifelse
  { closepath fill } if  stroke
  grestore
} bind def
/omark { % i j lw r g b omark
  % stroke segment [i..j] with linewidth lw, color rgb
  false 7 1 roll segmark
} bind def
/Fomark { % i j r g b Fomark
  % fill segment [i..j] with color rgb
  % should precede drawbases
  1 4 1 roll true 7 1 roll segmark
} bind def
/BFmark{ % i j k l r g b BFmark
  % fill block between pairs (i,j) and (k,l) with color rgb
  % should precede drawbases
  gsave
  setrgbcolor
  newpath
  currentdict (cpr) known
  {
    dup 1 sub coor exch get aload pop moveto % move to l
    dup 1 sub 4 -1 roll dup 5 1 roll 1 sub 1 exch
    { coor exch get aload pop lineto } for % lines from l to j
    3 -1 roll 4 -1 roll dup 5 1 roll arccoords curveto % curve from j to i
    exch dup 4 -1 roll 1 sub exch 1 sub 1 exch
    { coor exch get aload pop lineto } for % lines from i to k
    exch arccoords curveto% curve from k to l
  }
  {  exch 4 3 roll exch 1 sub exch 1 sub dup
     coor exch get aload pop moveto
     exch 1 exch { coor exch get aload pop lineto } for
     exch 1 sub exch 1 sub dup
     coor exch get aload pop lineto
     exch 1 exch { coor exch get aload pop lineto } for
  } ifelse
    closepath fill stroke
   grestore
} bind def
/hsb {
  dup 0.3 mul 1 exch sub sethsbcolor
} bind def
/colorpair { % i j hue sat colorpair
  % draw basepair i,j in color
  % 1 index 0.00 ne {
  gsave
  newpath
  hsb
  fsize setlinewidth
  currentdict (cpr) known
  {
    exch dup
    coor  exch 1 sub get aload pop moveto
    exch arccoords curveto
  }
  { 1 sub coor exch get aload pop moveto
    1 sub coor exch get aload pop lineto
  } ifelse
   stroke
   grestore
   % } if
} bind def

/ConsLegend { % xloc yloc tics range ConsLegend -> []
  /STR 8 string def
  /colshift 0.16 def
  /sep 0.1 def
  /range exch def
  % precompute number of tics but leave one tics for range numbers
  dup /tics exch dup 1 le { pop 42 } if def
  /lasttick exch dup 1 eq { pop 1.0 } { dup 1 gt { cvi } if  } ifelse def
  
  gsave
    /Helvetica findfont 10 scalefont setfont
    xmin xmax add size sub 2 div
    ymin ymax add size sub 2 div translate
    size dup scale
    translate
    0.015 dup scale
    % legend lines
    gsave 
    0.5 setgray
    0.05 setlinewidth
    newpath
    -1.5 2.5 moveto 10.1 2.5 lineto
    stroke
    newpath
    -1.5 1.1 moveto 10.1 1.1 lineto
    stroke
    newpath
    -1.5 2.5 moveto -1.5 -5 -6 sep mul add lineto
    stroke
    newpath
    10.1 1.1 moveto 10.1 -5 -6 sep mul add lineto
    stroke
    newpath
    -0.1 1.1 moveto -0.1 -5 -6 sep mul add lineto
    stroke
    newpath
    -0.1 -5 -6 sep mul add moveto 10.1 -5 -6 sep mul add lineto
    stroke
    grestore
    % color gradients
      6 -1 1
      {
        % get current number of different base pairs
        dup 1 sub 6 exch sub /curnum exch STR cvs def
        % compute y-position
        dup 6 sub dup sep mul add /ypos exch def
        % draw number of different base pairs
        -1 ypos moveto gsave 0.1 dup scale curnum show grestore
        % compute current color
        6 exch sub colshift mul
        /curcol exch def
        % draw gradient for counter examples
        gsave
        10 tics 1 add div 1 scale
        0 1 tics
        {
            dup ypos moveto
            tics div range mul 1 exch sub
            curcol exch hsb
            1 0 rlineto 0 1 rlineto -1 0 rlineto closepath fill
        } for
        grestore
      } for
    0 setgray
    % legend labels
    0.1 1.2 sep add moveto (0) gsave 0.1 dup scale show grestore
    9.4 1.2 sep add moveto lasttick STR cvs gsave 0.1 dup scale show grestore
    1 3 moveto (counter examples) gsave 0.1 dup scale show grestore
    -2 -4.5 moveto 90 rotate (base pairs)  gsave 0.1 dup scale show grestore
%    gsave 0.1 dup scale dup stringwidth pop -2 div 0 rmoveto show grestore
  grestore
} bind def
